OutReservoirsInit Subroutine

public subroutine OutReservoirsInit(list, path_out)

initialise files for output

Arguments

Type IntentOptional Attributes Name
type(Reservoir), intent(in), POINTER :: list
character(len=*), intent(in) :: path_out

Variables

Type Visibility Attributes Name Initial
type(Reservoir), public, POINTER :: currentReservoir
character(len=100), public :: string

Source Code

SUBROUTINE OutReservoirsInit &
  !
  (list, path_out)

IMPLICIT NONE


!arguments with intent(in):
TYPE(Reservoir), POINTER, INTENT(IN)   :: list !list of reservoirs
CHARACTER ( LEN = *), INTENT(IN) :: path_out

!local declarations:
TYPE(Reservoir), POINTER   :: currentReservoir !current reservoir in alist
CHARACTER (len = 100) :: string

!------------------------------end of declarations-----------------------------

currentReservoir => list
DO WHILE (ASSOCIATED(currentReservoir)) !loop trough all reservoirs
    
    string = ToString (currentReservoir % id)
    currentReservoir % fileunit_out = GetUnit ()
    OPEN(currentReservoir % fileunit_out,&
         file = path_out (1:LEN_TRIM(path_out))//'reservoir_'//&
               TRIM(string)//'.out')
     WRITE(currentReservoir % fileunit_out,'(a)') 'FEST: reservoir routing'
     WRITE(currentReservoir % fileunit_out,'(a,a)') &
         'reservoir name: ', currentReservoir % name &
        (1:LEN_TRIM(currentReservoir % name))
     IF ( currentReservoir % typ == 'off' ) THEN
        WRITE(currentReservoir % fileunit_out,'(a)')  'reservoir type: offstream'
     ELSE
        WRITE(currentReservoir % fileunit_out,'(a)')  'reservoir type: onstream'
     END IF
     IF ( currentReservoir % bypassIsPresent ) THEN
        WRITE(currentReservoir % fileunit_out,'(a)')  'with diversion: yes'
     ELSE
        WRITE(currentReservoir % fileunit_out,'(a)')  'with diversion: no'
     END IF
     WRITE(currentReservoir % fileunit_out,'(a,i4)') 'reservoir id: ', currentReservoir % id
     WRITE(currentReservoir % fileunit_out,*)
     WRITE(currentReservoir % fileunit_out,'(a)')'data'
     
     SELECT CASE ( currentReservoir % typ )
     CASE ( 'off' )
          IF ( currentReservoir % bypassIsPresent ) THEN
             WRITE(currentReservoir % fileunit_out,'(A)') 'DateTime h[m] Volume[m3] &
                Qupstream[m3/s] Qdownstream[m3/s] &
                 QinChannel[m3/s] QoutChannel[m3/s]'
          ELSE
             WRITE(currentReservoir % fileunit_out,'(A)') 'DateTime h[m] Volume[m3] &
                Qupstream[m3/s] Qdownstream[m3/s]'
          END IF
        
     CASE ( 'on' )
             WRITE(currentReservoir % fileunit_out,'(A)') 'DateTime h[m] Volume[m3] &
                 Qupstream[m3/s] Qdownstream[m3/s] &
                 QinChannel[m3/s] QoutChannel[m3/s]'
     END SELECT
    
     currentReservoir => currentReservoir % next
    
END DO

RETURN
END SUBROUTINE OutReservoirsInit